#|_____________________________________________________
 |
 | Correlation and VAR demonstration.
 | Demonstrates Leverage and Restriction of Range.
 | Written by Viji Sathy, November, 1997
 | Minor Modifications by Forrest Young, Decemver, 1997
 |_____________________________________________________
 |
 | Usage:
 | LEVERAGE:  (reg-demo mathsat gpa "influence")
 | RANGE:     (reg-demo mathsat gpa "range")
 |_____________________________________________________
 |
 | System Requirements: ViSta 6.0 or higher
 |________________________________________________________
 |#



(unless (boundp '*corr-demo-data-loaded*) 
        (var gpa (list 3.4 3.65 2.9 2.5 3.07 2.3 2.75 3.3 3.4 3.0 3.7 3.1 
                       3.0 2.9 2.9 3.2 2.8 3.5 3.0 2.9 2.85 2.2 2.8 3.6 2.8 2.5 2.9 
                       3.86 2.8 2.6 3.5 3.5 2.5 3.2 3.74 3.7 2.5 3.93 2.8 2.8 3.2))

        (var mathsat (list 640.0 550.0 640.0 620.0 440.0 710.0 600.0 680.0 
                           560.0 550.0 680.0 575.0 720.0 490.0 590.0 650.0 
                           340.0 550.0 610.0 560.0 440.0 400.0 600.0 610.0 
                           690.0 530.0 650.0 590.0 670.0 490.0 700.0 720.0 
                           500.0 480.0 750.0 600.0 700.0 680.0 520.0 540.0 550.0))
        
        (dataset gpasat gpa mathsat)
        (setf *corr-demo-data-loaded* t))



(defun influence-effect-plot (data &key (title "Influential Points") 
                                   (size '(400 456)) (location '(0 0))
                                   (show t) variable-labels)
  (reg-plot data :title title :show show :demo "influence"
            :size size :location location
            :variable-labels variable-labels))

(defun restriction-of-range-plot (data &key (title "Restriction of Range") 
                                   (size '(400 456)) (location '(0 0))
                                   (show t) variable-labels)
  (reg-plot data :title title :show show :demo "range" 
            :size size :location location
            :variable-labels variable-labels))



;CONSTRUCTOR FUNCTION AND DEFPROTO (FOR REGRESS-PLOT-PROTO)


(defun reg-plot  (data &key (title "Correlation Demo") (show t) 
                       location size (go-away t) variable-labels
                       demo) 
  (send regress-plot-proto :new data :show show :title title 
        :location location :size size :go-away go-away :demo demo
        :variable-labels variable-labels)
  )
  

(defproto regress-plot-proto '(data origcoefs coefs overlay demo) nil
  scatterplot-proto)              

(defmeth regress-plot-proto :data (&optional (list nil set))
  (if set (setf (slot-value 'data) list))
  (slot-value 'data))

(defmeth regress-plot-proto :overlay (&optional (list nil set))
  (if set (setf (slot-value 'overlay) list))
  (slot-value 'overlay))

(defmeth regress-plot-proto :coefs (&optional (list nil set))
  (if set (setf (slot-value 'coefs) list))
  (slot-value 'coefs))

(defmeth regress-plot-proto :demo (&optional (string nil set))
  (if set (setf (slot-value 'demo) string))
  (slot-value 'demo))

(defmeth regress-plot-proto :origcoefs (&optional (list nil set))
  (if set (setf (slot-value 'origcoefs) list))
  (slot-value 'origcoefs))

(defmeth regress-plot-proto :isnew                                       
         (data &key (show t) (title "Reg Demo") location size (go-away t)       
         variable-labels demo)          
                                      
  (let ((g (call-next-method                                          
            (length data) :show nil :title title                         
            :location location :size size :go-away go-away               
            :variable-labels variable-labels)))
    (send self :plot-buttons :new-x nil :new-y nil :pop nil :help nil)
    (send self :data data)
    (send self :demo demo)
    (send self :add-points data)                                       
    (send self :adjust-to-data)                                          
    (send self :add-mouse-mode 'point-moving                             
          :title "Leverage"                                          
          :cursor 'finger                                                
          :motion :do-actions)
    (send self :add-mouse-mode 'restricting-range                        
          :title "Range Restriction"                                     
          :cursor 'finger                                                
          :motion :do-actions) 
    (send self :use-color t)
    (send self :point-color (iseq (send self :num-points)) 'blue)
    (send self :mouse-mode 'point-moving)
    (send self :set-regression-line) 
    (send self :add-margin) 
    (send self :overlay (make-reg-overlay))
    (send self :add-overlay (send self :overlay)) 
    (defmeth self :do-motion (x y)
      (let* ((margin (send self :margin))
             )
        (cond
          ((and (> (second margin) 0) (<= y (second margin)))
           (send self :cursor 'solid-arrow))
          ((and (> (fourth margin) 0)
                (> y (- (send self :canvas-height) (fourth margin))))
           (send self :cursor 'solid-arrow))
          ((and (> (first margin) 0) (<= x (first margin)))
           (send self :cursor 'solid-arrow))
          ((and (> (third margin) 0) 
                (> x (- (send self :canvas-width) (third margin))))
           (send self :cursor 'solid-arrow))
          (t
           (when (not (eq (send self :cursor) (send self :set-mode-cursor)))
                 (send self :cursor) (send self :set-mode-cursor))
           (send self :do-actions x y)))))
    (when show (send self :show-window))
    (when (equal (send self :demo) "range")
          (send self :mouse-mode 'restricting-range)
          (send self :do-actions 100 100))
    )
  )    

;OBJECT METHODS                                                          
  
(defmeth regress-plot-proto :add-margin ()                               
  (let ((h (+ (send self :text-ascent) (send self :text-descent)))       
        )                                                                
  (send self :margin 0 (+ 5 h) 0 (round (* 3.0 h)))))                        
  
               
(defmeth regress-plot-proto :do-actions (x y)  
 
  (when (or (not (< 0 x (first (send self :size))))
            (not (< 0 y (second (send self :size)))))
        (setf x (first (send self :content-rect)))
        (setf y (second (send self :content-rect))))
  (cond
    ((equal (send self :mouse-mode) 'point-moving)
     (send self :leverage-point x y))
    ((equal (send self :mouse-mode) 'restricting-range)
     (send self :restrict-range x y))))                                                          
  
(defmeth regress-plot-proto :leverage-point (x y)
  (send self :point-state (iseq (send self :num-points)) 'normal)
  (send self :redraw)
  (when (send self :drag-point x y :draw nil)
        (send self :set-regression-line)))
  
(defmeth regress-plot-proto :restrict-range (x y)                        
  (let ((cr (send self :content-rect))                                   
        (coefs (send self :calculate-coefficients x ))) 
    (send self :clear-lines :draw nil) 
    (when coefs  
          (send self :coefs coefs)
          (send self :abline (select coefs 0) (select coefs 1)))               
    (when (< (first cr) x (+ (first cr) (third cr)))                     
          (send self :draw-line x (second cr) x 
                (+ (second cr) (fourth cr))))
    (send self :redraw))
    )

(defmeth regress-plot-proto :set-regression-line ()                      
  (let ((coefs (send self :calculate-coefficients))
        (origcoefs (send self :original-coefficients)))
    (send self :origcoefs origcoefs)
    (send self :coefs coefs)   
    (send self :redraw t)
    (send self :clear-lines :draw nil)                                   
    (send self :abline (select coefs 0) (select coefs 1))
    ))    

(defmeth regress-plot-proto :original-coefficients ()
  (let* (
         (data (send self :data))
         (rm (regression-model (first data) (second data) :print nil)))
    (combine (send rm :coef-estimates) (sqrt (send rm :r-squared)))))
         
(defmeth regress-plot-proto :calculate-coefficients (&optional
restrict-x)                      
  (let* ((mm (send self :mouse-mode))
         (i (iseq 0 (- (send self :num-points) 1)))
         (x (send self :point-coordinate 0 i))
         (y (send self :point-coordinate 1 i))
         (cutoff-x nil)
         (nobs (send self :num-points))
         (selected-obs nil)
         (deselected-obs nil)
         (m nil))
    
    (cond
      ((equal mm 'point-moving)
       (setf m (regression-model x y :print nil))
       (if m (combine (send m :coef-estimates) (sqrt (send m :r-squared)))))
      ((equal mm 'restricting-range)
       (setf cutoff-x (first (send self :canvas-to-real restrict-x 1)))
       (when (> restrict-x 0)
             (setf selected-obs (which (< cutoff-x x)))
             (setf deselected-obs (which (> cutoff-x x)))
             (send self :point-state (iseq nobs) 'normal)
             (when deselected-obs 
                   (send self :point-state deselected-obs 'invisible))
             (when (> (length selected-obs) 1)
                   (setf m (regression-model (select x selected-obs) 
                                             (select y selected-obs) :print nil))
                   (if m (combine (send m :coef-estimates) 
                                  (sqrt (send m :r-squared))))))))
    ))
                                                                         
(defmeth regress-plot-proto :adjust-screen ()                            
  (if (send self :needs-adjusting)                                       
      (send self :set-regression-line))                                    
  (call-next-method))         

;CONSTRUCTOR FUNCTION AND DEFPROTO (FOR REGRESS-OVERLAY-PROTO):          
                                                                         
(defun make-reg-overlay ( )                                              
  (send regress-overlay-proto :new))                                                                                                              
  
(defproto regress-overlay-proto '() () graph-overlay-proto)    

(defmeth regress-overlay-proto :redraw (&optional flag)                                  
  (let* ((graph (send self :graph))                                      
         (coefs (send graph :coefs))
         (origcoefs (send graph :origcoefs))
         (cr (send graph :content-rect))                                 
         (text-height (+ (send graph :text-ascent)                       
                         (send graph :text-descent)))                    
         (line0 (- (send graph :canvas-height)                           
                   (round (* 3 text-height)) 5))                           
         (line1 (+ line0 text-height))                                   
         (line2 (+ line1 text-height))                                   
         (line3 (+ line2 text-height))       
         (indent 15)                                                     
         (gap 15)                                                        
         (tw1 (send graph :text-width "Original "))                      
         (tw2 (send graph :text-width " 3.33 "))                         
         (tw3 (send graph :text-width " y= a.aa + b.bbx "))              
         (x1 (+ indent tw1 gap (floor (/ tw2 2))))                       
         (x2 (+ x1 gap (floor (/ (+ tw2 tw3) 2))))
         )                                                               
    (send graph :draw-line    0 line0 (send graph :canvas-width) line0)  
    (send graph :draw-color  'light-blue)
    (send graph :paint-rect   0 (1+ line0) (send graph :canvas-width) 
          (+ 5 (round (* 3 text-height))))
    (send graph :draw-color  'black)
    (send graph :draw-text   "R" x1 line1  1 0)                          
    (send graph :draw-text   "Equation" x2 line1 1 0)                    
    (send graph :draw-string "Original:" indent line2)                   
    (send graph :draw-string "Current:" indent line3)                       
    (send graph :draw-text   
          (FORMAT NIL "~5,3f" (THIRD COEFS))
          x1 line3 1 0)                            
    (send graph :draw-text   
          (format nil "~5,3f" (third origcoefs))
          x1 line2  1 0)                           
    (send graph :draw-text   
          (format nil "  y= ~5,2f + ~5,2fx" (first coefs) (second coefs))
          x2 line3  1 0)
    (send graph :draw-text 
          (format nil "  y= ~5,2f + ~5,2fx" (first origcoefs) (second
origcoefs))
          x2 line2  1 0)))


(defun reg-demo (varx vary demo)
  (let* ((cont (container :in nil :style 1 :free t :show nil
                          :size '(400 456) :location '(0 0)))
         (plot))
    (enable-container cont)
    (cond
      ((equal demo "range")
       (setf plot (restriction-of-range-plot
                   (list  varx vary) :variable-labels '( "MathSAT" "GPA")
                   :location '(0 0) :size '(408 430)))
       (send cont :title "Regression: Effect of Predictor Range Restriction")
       (setf reg-msg 
             (display-window 
              (format nil "~%Regression:~%Restriction of Predictor Range~2%The range of the predictor variable can have an effect on the regression equation and correlation coefficient. Restricted range can radically change the value of the correlation coefficient and the position of the regression line.~2%To see the effect, move your cursor at a medium speed back and forth across the graph. As you move your cursor back and forth, a vertical line moves back and forth. The vertical line is a cutoff value representing a restriction on the range of the predictor variable (~a) such that no observations are obtained below the cutoff. Thus, observations less than the cutoff are removed from the analysis and the regression is performed on the remaining observations.~2%The current correlation coefficient value and regression line vary. The original and current values of the correlation coefficient are shown in the bottom part of the graph window, along with both the original and current equation for drawing the regression line (the regression equation). The position of the regression line is shown in the plot." "MathSat")
              :pop-out-on-show nil
              :show nil
              :container cont)))
      (t
       (setf plot (influence-effect-plot
                   (list  varx vary ) :variable-labels '( "MathSAT" "GPA")
                   :location '(0 0) :size '(408 430)))
       (send cont :title "Regression: Influential Points")
       (setf reg-msg 
             (display-window 
              (format nil "~%Regression:~%Influential Points~2%The position of some points can radically change the value of the correlation coefficient and the position of the regression line. Not all points have this effect, but those that do are called INFLUENTIAL points.~2%To see the effect, put your cursor near a point, and VERY SLOWLY move the cursor around. If you do this carefully, the point will follow the cursor, and the regression will be recalculated every time the point moves, using the new position of the point.~2%The original and current values of the correlation coefficient are shown below the graph, along with two equations: the original and current equation for drawing the regression line (the regression equation). The position of the regression line is shown in the plot.~2%Note that points that are near the ends of the distribution have more influence than those in the middle." )
              :show nil
              :pop-out-on-show nil
              :container cont))))
    (send reg-msg  :pop-out-on-show nil)
    (apply #'send cont :size (- (effective-screen-size) '(28 28)))
    (defmeth cont :resize ()
      (call-next-method)
      (apply #'send self :size (mapcar #'max '(640 480) (send self :size)))
      (let ((width (first (send self :size)))
            (height (second (send self :size))))
        (send plot :size  (- height 56) (- height 38))
        (send reg-msg :size (- width (first (send plot :size)) 19) (- height 38))
        (send reg-msg :location (+ 11 (first (send plot :size)))
              (second (send plot :location)))
        (send reg-msg :resize)))
  
    (send reg-msg :show-window)
    ;(send cont :resize)
    (apply #'send cont :size (effective-screen-size))
    (send cont :show-window)
    ))

;(list-dialog "Choose Demo" (list "Restriction of Range" "Influence Points")
;             (list '(reg-demo gpa mathsat "range") '(reg-demo gpa mathsat "influence")))